perm filename SMALLX.FAI[XX,LCS]1 blob
sn#179221 filedate 1975-09-25 generic text, type T, neo UTF8
00100 TITLE SMALL
00200 INTERNAL RJBX,CENTX,EXTEN,JDRAW,CENTER,LINX,UNPACK,ROFF,NOIR
00300 INTERNAL NOZERO,EXCH,BMS,IABS,RHORZ,ABS,RTLINE,FLOAT,IFIX
00400 EXTERNAL .COMM.,STF,POSI,LL,LINES,BM,XRN,PTR,AMOD,MOD,PLOT
00450 EXTERNAL PLTR,SQRT
00500 ;; DEFINE FLOAT(N)
00600 ;; < TLC N,232000
00700 ;; FADR N,N >
00800 DEFINE FIXX(N)
00900 < JUMPGE N,.+5
01000 MOVNS N
01100 FIX N,233000
01200 MOVNS N
01300 CAIA
01400 FIX N,233000 > ; TO FIX IT LIKE 'IFIX' DOES.
01500
01600
01700
01800 RJBX: 0 ;R3=R3+R*RSTJ2
01900 MOVE 2,@(16)
02000 FMPR 2,STF+=8
02100 FADRM 2,.COMM.+=4
02200 JRA 16,1(16)
02300
02400 CENTX: 0 ;CENTX=POS-18.*RSTJ2+AMOD(R4,100.0)*RSTJ2*7.
02500 JSA 16,AMOD
02600 JUMP .COMM.+5
02700 JUMP [=100.0]
02800 FMPR STF+=8
02900 FMPR [=7.0]
03000 MOVN 2,[=18.0]
03100 FMPR 2,STF+=8
03200 FADR 2,POSI+=9
03300 FADR 2
03400 MOVEM .COMM.+2
03500 JRA 16,(16)
03600
03700
03800 EXTEN: 0 ;FUNCTION EXTEN(X)
03900 HRRM 16,.+2
04000 JSA 16,AMOD ;EXTEN=AMOD(X,1.)*10.
04100 JUMP @0
04200 JUMP [=1.0]
04300 FMPR [=10.0]
04400 JRA 16,1(16)
04500
04600
04700 AA: 0
04800 BB: 0
04900 CC: 0
05000 DD: 0
05100
05200 JDRAW: 0 ;SUBROUTINE JDRAW(M,R3,CENTR,RSTJ2,RX,RY)
05300 MOVE 2,@3(16) ;COMMON/LL/LL
05400 MOVE 13,@4(16) ;DIMENSION M(1)
05500 FMPR 13,2 ;RC=RX*RSTJ2
05600 MOVE 14,@5(16) ;RD=RY*RSTJ2
05700 FMPR 14,2 ;13 HAS RC, 14 HAS RD
05800 MOVE 3,@(16) ;DO 2 K=2,M(1)
05900 HRRZ 12,(16) ; BRING IN ADR. OF M (ZERO LEFT HALF)
06000 MOVE 10,(12) ;PUT ADR. OF M IN 10
06100 ADDI 10,-1(12)
06200 L2: AOJ 12, ; SET UP LOOP
06300 CAILE 12,(10) ; SEE IF WE'VE PASSED END OF LOOP
06400 JRA 16,6(16) ; GO HOME
06500 HRRZM 12,.+4 ; PUT ADR. OF VALUE M(K) IN LAST JUMP
06600 ; CALL UNPACK(A,B,M(K))
06700 JSA 16,UNPACK
06800 JUMP AA
06900 JUMP BB
07000 JUMP
07100 ;2 CALL LINES(FLOAT(A)*RC+R3,FLOAT(B)*RD+CENTR,LL)
07200 ;; JSA 16,FLOAT
07300 ;; JUMP AA
07400 MOVE 0,AA
07500 TLC 0,232000
07600 FADR 0,0
07700 FMPR 13
07800 FADR @1(16)
07900 MOVEM AA
08000 ;; JSA 16,FLOAT
08100 ;; JUMP BB
08200 MOVE 0,BB
08300 TLC 0,232000
08400 FADR 0,0
08500 FMPR 14
08600 FADR @2(16)
08700 MOVEM BB
08800 JSA 16,LINES
08900 JUMP AA
09000 JUMP BB
09100 JUMP LL
09200 JRST L2
09300
09400 CENTER: 0 ; SUBROUTINE CENTER(CNTR)
09500 ; TO CENTER ITEMS CREATED WITH DRAWING PROG.
09600 ; COMMON /STF/RSTFAC(8),RSTJ2
09700 ; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
09800 ; COMMON/POSI/STF(8),JJ2,POS
09900 ; EQUIVALENCE (R4,RJQ(2))
10000 JSA 16,AMOD ;CNTR=POS+(2+AMOD(R4,100.)*7)*RSTJ2
10100 JUMP .COMM.+5
10200 JUMP [=100.0]
10300 FMPR [=7.0]
10400 FADR [=2.0]
10500 FMPR STF+=8
10600 FADR POSI+=9
10700 MOVEM @(16)
10800 JRA 16,1(16)
10900
11000 LINX: 0 ; SUBROUTINE LINX(A,B,C,D)
11100 ; C SAVES SPACE FOR SINGLE LINES.
11200 MOVE @(16) ;CALL LINES(A,B,3)
11300 MOVEM AA
11400 MOVE @1(16)
11500 MOVEM BB
11600 MOVE @2(16) ;CALL LINES(C,D,2)
11700 MOVEM CC
11800 MOVE @3(16)
11900 MOVEM DD
12000 JSA 16,LINES
12100 JUMP AA
12200 JUMP BB
12300 JUMP [=3]
12400 JSA 16,LINES
12500 JUMP CC
12600 JUMP DD
12700 JUMP [=2]
12800 JRA 16,4(16)
12900
13000 UNPACK: 0 ; SUBROUTINE UNPACK(M,N,I)
13100 ; COMMON/LL/L
13200 ;C L IS FOR VIS. OR INVIS. LINES.
13300 MOVE @2(16) ; N=I
13400 MOVE 3,
13500 IDIV [=100000000] ; M=N/100000000
13600 JUMPE O2 ; IF(M.EQ.0)GO TO 2
13700 MOVEI 2,3 ; L=3
13800 IMUL [=100000000] ; N=N-100000000*M
13900 MOVNS
14000 ADD 3,0 ; 3 HAS N, 4 HAS M(LATER)
14100 JRST M2
14200 O2: MOVEI 2,2 ; L=2
14300 M2: MOVE 4,3
14400 IDIVI 4,23420 ;2 M=N/10000
14500 MOVEM 2,LL ; PUTS AWAY L
14600 MOVEM 3,AA
14700 JSA 16,MOD ; N=MOD(N,10000)
14800 JUMP AA
14900 JUMP [=10000]
15000 MOVEI 2,1750 ; IF(M.GT.1000)M=1000-M
15100 CAML 2,4
15200 JRST N2
15300 MOVEI 2,1750
15400 MOVNS 4
15500 ADD 4,2
15600 N2: CAML 2, ; IF(N.GT.1000)N=1000-N
15700 JRST P2
15800 MOVNS
15900 ADD 2
16000 P2: MOVEM 4,@(16)
16100 MOVEM 0,@1(16)
16200 JRA 16,3(16)
16300
16400 ROFF: 0 ; FUNCTION ROFF(R)
16500 MOVSI 200400 ; S=.5
16600 SKIPGE 1,@(16) ; IF(R)S=-S
16700 MOVNS
16800 FADR 1 ; ROFF=R+S
16900 JRA 16,1(16)
17000
17100 NOZERO: 0 ;SUBROUTINE NOZERO(X)
17200 SKIPE @(16) ; IF(X.EQ.0)X=1
17300 JRA 16,1(16)
17400 MOVE [=1.0] ; MAKE ALL ZEROS INTO ONES.
17500 MOVEM @(16)
17600 JRA 16,1(16)
17700
17800 EXCH: 0 ; SUBROUTINE EXCH(X,Y)
17900 MOVE @(16)
18000 EXCH 0,@1(16)
18100 MOVEM 0,@(16)
18300 JRA 16,2(16)
18400
18500 BMS: 0 ; SUBROUTINE BMS
18600 MOVE BM+1 ;COMMON/STF/RSTFAC(-3/4),RSTJ2/BM/RA,RC,RKY
18700 FMPR STF+=8 ; CALL LINES(RA,RJY+RC*RSTJ2,2)
18800 FADR BM+2
18900 MOVEM BB
19000 JSA 16,LINES ; END
19100 JUMP BM
19200 JUMP BB
19300 JUMP [2]
19400 JRA 16,(16)
19500
19600 IABS: 0 ; FUNCTION IABS(N)
19700 MOVM 0,@(16) ;BECAUSE IABS IN LIB40 HAS A BUG.
19800 JRA 16,1(16) ; IABS=N ; IF(N)IABS=-N
19900
20000 RHORZ: 0 ; FUNCTION RHORZ(R)
20100 MOVE @(16) ; RHORZ=R*5.96-596.
20200 FMPR [=5.96]
20300 FSBR [=596.0]
20400 JRA 16,1(16)
20500
20600 ABS: 0
20700 JRST IABS+1
20800
20900 RTLINE: 0 ;FUNCTION RTLINE(L)
21000 MOVE 2,.COMM. ;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
21100 CAMLE 2,[=4.0] ;RTLINE=-1
21200 JRST ZRO ;IF(R2.GT.4)GO TO 1
21300 ;; HRRZ @(16) ;IF(RN(L+2).NE.R2)RETURN
21350 MOVE 3,@(16)
21400 ;; HRRZI 3,XRN ; PUT ADR. OF XRN IN 3
21500 ;; ADD 3, ; 1 RTLINE=0
21600 SETO
21700 ;; CAMN 2,1(3)
21750 CAMN 2,XRN+1(3)
21800 ZRO: SETZ
21900 JRA 16,1(16)
22000
22100 FLOAT: 0
22200 MOVE 0,@(16)
22300 TLC 0,232000
22400 FADR 0,0
22500 JRA 16,1(16)
22600 IFIX: 0
22700 MOVE 0,@(16)
22800 JUMPGE 0,.+5
22900 MOVNS 0
23000 FIX 0,233000
23100 MOVNS 0
23200 CAIA
23300 FIX 0,233000
23400 JRA 16,1(16)
23500
23600 ;;;MOD: 0
23700 ;;; MOVE 2,@(16)
23800 ;;; IDIV 2,@1(16)
23900 ;;; IMUL 2,@1(16)
24000 ;;; MOVE @(16)
24100 ;;; SUB 2
24200 ;;; JRA 16,2(16)
24300
24400 J←10↔ A←2↔ B←3↔ C←4↔ D←5↔ E←6↔ N←11↔NX←12 ; SUBROUTINE NOIR(RMINI)
24500 Y←13↔ X←14↔ L←15↔ M←1
24600 JPOS: 0 ;C BLACKS IN NOTES
24700 IPOS: 0 ;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(12),B,C,KC,D,N,JY,M,L
24800 IC: 0
24900 K: 0
25000 NOIR: 0 ; COMMON/PLTR/IPLT,RHT,DIS /XRN/IRN(4000)
25100 MOVE A,.COMM.+4 ;EQUIVALENCE (PRE,IRN(1))
25200 FMPR A,PLTR+2 ;DATA BL/7.5/,BH/6.7/
25300 ; ADJUST BH AND FL FOR HEIGHT OF NOTE AND 'WIDTH'
25400 JSA 16,ROFF ;IPOS=ROFF(RJQ(1)*DIS)
25500 JUMP A
25600 FIXX(A)
25700 MOVEM A,IPOS
25800 MOVE A,.COMM.+2 ;JPOS=ROFF(CENTR*RHT)
25900 FMPR A,PLTR+1
26000 JSA 16,ROFF
26100 JUMP A
26200 FIXX(A)
26210 ;?? MOVE D,@(16)
26220 ;?? CAME D,STF+8 ;IF(RMINI.NE.RSTJ2)JPOS=JPOS+1
26250 ;?? AOS A ;TO PUSH MINI-NOTE UP ONE XGP NOTCH!!!! *******************
26300 MOVEM A,JPOS ;SAVE FOR LATER
26400 MOVN A,@(16) ;IF(-RMINI.EQ.PRE)GO TO 10
26500 CAMN A,XRN
26600 JRST NO10
26700 MOVEM A,XRN ;PRE=-RMINI
26800 MOVE D,[=0.25] ;D=.25
26900 MOVE B,[=6.7] ;B=BH*RMINI*RHT
27000 FMPR B,PLTR+1
27100 FMPR B,@(16)
27200 MOVE E,PLTR+2 ;E=RMINI*DIS
27300 FMPR E,@(16)
27400 MOVE A,[=7.5] ;A=BL*E
27500 FMPR A,E
27600 MOVE 15,A
27700 FIXX(15) ;IC=A
27800 MOVEM 15,IC
27900 FMPR A,A ;A=A*A
28000 MOVN E,B ;E=-B/4.
28100 FDVR E,[=4.0]
28200 MOVE 15,B ;K=B
28300 FIXX(15)
28400 MOVEM 15,K
28500 FMPR B,B ;B=B*B
28600 ; USES EQUATION FOR ELLIPSE
28700 MOVEI 11,1 ;N=1
28800 MOVEI NX,2 ;NX=2
28900 MOVN J,K ;6 DO 1 J=-K,K
29000 NO1: MOVE Y,J ;Y=J*J
29100 IMUL Y,Y
29200 TLC Y,232000
29300 FADR Y,Y ;FLOAT
29400 MOVN X,Y ;X=SQRT(A-(A*Y)/B)
29500 FMPR X,A
29600 FDVR X,B
29700 FADR X,A
29800 JSA 16,SQRT
29900 JUMP X
30000 MOVE X,0
30100 MOVE L,E ;L=E-X
30200 FSBR L,X
30300 FIXX(L)
30400 MOVE M,X ;M=X+E
30500 FADR M,E
30600 FIXX(M) ; THE TWO SIDES OF THE LINE
30700 SKIPGE 11 ;IF(N)CALL EXCH(L,M)
30800 EXCH L,M
30900 ;; HRRZI 7,XRN ;IRN(NX)=L
31000 ;; ADDI 7,(NX)
31100 ;; MOVEM L,-1(7)
31200 ;; MOVEM M,(7) ;IRN(NX+1)=M
31210 MOVEM L,XRN-1(NX)
31220 MOVEM M,XRN(NX)
31300 ; C IS VERTICLE POS.
31400 ADDI NX,2 ;NX=NX+2
31500 FADR E,D ;E=E+D
31600 ; E IS TO TILT IT.
31700 MOVNS 11 ;1 N=-N
31800 CAMGE J,K
31900 AOJA J,NO1 ;LOOP BACK
32000 NO10: MOVE J,IPOS ;10 CALL PLOT(IPOS+3,JPOS,3)
32100 ADDI J,3
32200 JSA 16,PLOT
32300 JUMP J
32400 JUMP JPOS
32500 JUMP [3]
32600 MOVEI 11,2 ;N=2
32700 ; 1ST LOC. OF ARRAY HAS "PRE"
32800 MOVE L,IC ;L=IPOS+IC
32900 ADD L,IPOS
33000 MOVN M,K ;DO 11 M=-K,K
33100 NO11: MOVE J,JPOS ;J=M+JPOS
33150 MOVEM M,AA
33200 ADD J,M
33300 ;; HRRZI X,XRN ;CXLL PLOT(L+IRN(N),J,2)
33400 ;; ADDI X,(11)
33500 ;; MOVE NX,-1(X)
33510 MOVE NX,XRN-1(11)
33600 ADD NX,L
33700 JSA 16,PLOT
33800 JUMP NX
33900 JUMP J
34000 JUMP [2]
34100 ;; MOVE NX,(X) ;CXLL PLOT(L+IRN(N+1),J,2)
34110 MOVE NX,XRN(11)
34200 ADD NX,L
34300 JSA 16,PLOT
34400 JUMP NX
34500 JUMP J
34600 JUMP [2]
34700 ADDI 11,2 ;11 N=N+2
34750 MOVE M,AA
34800 CAMGE M,K
34900 AOJA M,NO11
35000 JRA 16,1(16)
35100
35200 END